Developer CD Series 1992 June: ROMin Holiday

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / Apple II / Apple II Sample Code / MPW IIGS SC / SC.021.Dynamo / app.builder / build.a < prev next >

Wrap

Text File | 1990-06-24 | 15.3 KB | 823 lines | [TEXT/MPS ]

**************************************************************** * * * buildapp.system * * * * Apple II 8-bit application builder and launcher. * * Copyright (C) 1990 Apple Computer. * * Version 3.1 * * * * Written by Eric Soldan, Apple II DTS * * * * Developer Technical Support Apple II Sample Code * * * **************************************************************** include ':dynamo.includes:sys.equ' include ':dynamo.includes:rt.h' include ':dynamo.includes:rt.macros' include 'app.config' ********************************************* buildText equ $1600 ;Script file for building application. fileName equ $1E00 ;filestr starts at $1E01. Runtime ;strings aren't pascal-type. There ;is a table called strlens that holds ;the lengths. There is another table ;called maxstrlens that defines how ;big each string can get. ;To make a pascal string for ProDOS, ;the characters for the file name ;are placed in filestr. Then the ;string length byte is copied to ;fileName, just in front of filestr. ;Now we have a regular pascal string ;for ProDOS. btFileName equ $1E80 ;This is the boot time file name. If ;the user of BUILDAPP.SYSTEM wants to ;have his text in a file other than ;BUILDAPP.TEXT, or if the script file ;is in another directory, then he can ;place the pathname of the file into ;BUILDAPP.SYSTEM, starting at byte $2006. ;This is the standard way for launched ;programs to be given a pathname. The ;default pathname in this location ;is BUILDAPP.TEXT. btpathstr starts at ;$1E81. This string works like filestr, ;in reverse. The pascal string is first ;copied into btFileName, and then the ;length byte is stored in the strlens ;table. The reason for copying the ;string from $2006 is because this area ;will be written over, and if the user ;wants to re-run the program due to an ;error, this string would have been lost. ********************************************* MLI equ $BF00 ;Various equates for ProDOS. paramCount equ $00 CREATE equ $C0 create_pathname equ $01 create_access equ $03 create_filetype equ $04 create_auxtype equ $05 create_strgtype equ $07 create_createdate equ $08 create_createtime equ $0A OPEN equ $C8 open_pathname equ $01 open_iobuffer equ $03 open_refnum equ $05 READ equ $CA read_refnum equ $01 read_databuffer equ $02 read_reqcount equ $04 read_transcount equ $06 WRITE equ $CB write_refnum equ $01 write_databuffer equ $02 write_reqcount equ $04 write_transcount equ $06 SETEOF equ $D0 setEOF_refnum equ $01 setEOF_EOF equ $02 SETFILEINFO equ $C3 setInfo_pathname equ $01 setInfo_access equ $03 setInfo_filetype equ $04 setInfo_auxtype equ $05 setInfo_nullfield equ $07 setInfo_moddate equ $0A setInfo_modtime equ $0C GETFILEINFO equ $C4 getInfo_pathname equ $01 getInfo_access equ $03 getInfo_filetype equ $04 getInfo_auxtype equ $05 getInfo_strgtype equ $07 getInfo_blksused equ $08 getInfo_moddate equ $0A getInfo_modtime equ $0C getInfo_crdate equ $0E getInfo_crtime equ $10 CLOSE equ $CC close_refnum equ $01 QUIT equ $65 ********************************************* numstrings equ 5 bffrstr equ 0 maxbffrstr equ 127 bffrstrloc equ $1D01 tempstr equ 1 maxtempstr equ 127 tempstrloc equ $1D81 filestr equ 2 maxfilestr equ 127 filestrloc equ $1E01 btpathstr equ 3 maxbtpathstr equ 64 btpathstrloc equ $1E81 pathstr equ 4 maxpathstr equ 127 pathstrloc equ $2007 ********************************************* export varspace varspace PROC ds.b 256 endp ****************** export strspace strspace PROC export strlens, maxstrlens, strlocs strlens ds.b numstrings maxstrlens dc.b maxbffrstr, maxtempstr, maxfilestr, maxbtpathstr, maxpathstr strlocs dc.w bffrstrloc, tempstrloc, filestrloc, btpathstrloc, pathstrloc endp ****************** main PROC lda #0 ;Clear the variable space. tax ;This application does not @clearvars sta varspace,x ;need to variables to be inx ;pre-cleared. bne @clearvars ldx #64 ;Get boot path from system @getPath lda $2006,x ;file and place it in btpathstr. sta btFileName,x dex bpl @getPath lda btFileName sta strlens+btpathstr ****************** restart lda #0 ;This string is the last read from the sta strlens+bffrstr ;buildapp.text file. Init it to NULL. jsr $C300 ;Initialize 80-col screen. _writecr jsr home _rtreset _hibitchrs _write 'IIe Application builder v3.1',13,\ 'Copyright (C) 1990 by Apple Computer.',13,13,\ 'Building application, please wait.',13,13,13 _strcpy filestr,btpathstr ;Put file name of load build text ;in filestr. All proDOS operations ;that need a file name expect it in ;filestr in this application. jsr loadFile dc.w buildText dc.w $FFFF bcc @a _write 13,13,'Could not load ' _prstr filestr _write '.' jmp abort @a lda readBlock+read_transcount sta ptr lda readBlock+read_transcount+1 clc adc #>buildText ;Make sure that the build text sta ptr+1 ;ends with a c/r, or else _readstr lda #13 ;may get real unhappy. ldy #0 sta (ptr),y iny ;If a string of 1 char (a 255) is read, iny ;then the end of the file was read sta (ptr),y ;prematurely, and an error will be issued. dey lda #255 sta (ptr),y _restore #buildText ;Point readData at buildText. _readend #13 ;_readstr will stop at a c/r. _set buildaddr,*$2006+65 * The dispatcher has the ending location stored in this address. Point after * dispatcher. We don't have to load the dispatcher, since it is already at * $2000. (It was used to launch this application.) _var pathstr ;pathstr location is $2007, so text jsr getstr ;is read directly into dispatcher. bcc @ok1 jsr EOFMessage _write 'pathname.' jmp abort @ok1 lda strlens+pathstr sta $2006 ;Make a pascal string out of it. ****************** mainloop _var mode jsr getint bcc @ok2 jsr EOFMessage _write 'bank selection bit setting.' jmp abort @ok2 lda varspace+mode+1 bne @bad2 lda varspace+mode and #$87 cmp varspace+mode beq @ok2a @bad2 _write 'Bad bank selection bit setting (' _var mode lda decimalint bne @bad2a _write '$' _vhexout jmp @bad2b @bad2a _vdecout @bad2b _write ').' jmp abort @ok2a _var address jsr getint bcc @ok3 jsr EOFMessage lda varspace+mode bpl @aa _write 'starting' jmp @ab @aa _write 'segment' @ab _write ' address.' jmp abort @ok3 lda varspace+mode ;Bit 7 of mode byte indicates no bpl @a ;more segments. Following field jmp startaddr ;is launch address. @a _var filestr jsr getstr bcc @ok4 jsr EOFMessage _write 'filename.' jmp abort @ok4 _write 'Loading ' _prstr filestr _write '...',13 lda varspace+buildaddr ;Make space for 5 bytes that clc ;will be filled in later. adc #5 sta @addr lda varspace+buildaddr+1 adc #0 sta @addr+1 jsr loadFile @addr dc.w $2000 dc.w $FFFF bcc @b jmp noLoad @b lda varspace+buildaddr ;Put the segment relocation sta ptr ;information in front of segment. lda varspace+buildaddr+1 sta ptr+1 ldy #0 lda varspace+mode sta (ptr),y iny lda varspace+address sta (ptr),y iny lda varspace+address+1 sta (ptr),y iny lda readBlock+read_transcount sta (ptr),y iny lda readBlock+read_transcount+1 sta (ptr),y lda ptr ;Point past segment. clc adc #5 bcc @c inc ptr+1 clc @c adc readBlock+read_transcount sta varspace+buildaddr lda ptr+1 adc readBlock+read_transcount+1 sta varspace+buildaddr+1 jmp mainloop ;Load another segment. startaddr _write 13,'Starting address is ' _var tempstr jsr getstr bcc @ok5 jsr crEOFMessage _write 'address display format.' jmp abort @ok5 lda tempstrloc _var address cmp #'$' beq @hex _vdecout jmp @a @hex _rtcout _vhexout @a _writecr lda varspace+buildaddr ;Store the launch information. sta ptr lda varspace+buildaddr+1 sta ptr+1 ldy #0 lda varspace+mode sta (ptr),y iny lda varspace+address sta (ptr),y iny lda varspace+address+1 sta (ptr),y lda ptr ;Calculate application size. sec sbc #<$2000-3 sta varspace+applen lda ptr+1 sbc #>$2000-3 sta varspace+applen+1 _write 13,'Application length is ' _var tempstr jsr getstr bcc @ok6 jsr crEOFMessage _write 'length display format.' jmp abort @ok6 lda tempstrloc _var applen cmp #'$' beq @hex0 _vdecout jmp @a0 @hex0 _rtcout _vhexout @a0 _write 13,13,'Save application? (Y,N,Q) ' _var tempstr ;See if we have a script value for jsr getstr ;Y,N,Q. ldx strlens+tempstr beq @b ;Nothing, so no Y,N,Q script command. lda tempstrloc and #$5F cmp #'Y' beq @b0 cmp #'N' beq @b0 cmp #'Q' beq @b0 ;Wasn't a Y,N,Q script command. @b jsr rdkey @b0 and #$5F cmp #'Y' beq saveit cmp #'N' beq runit cmp #'Q' bne @b quit jsr rtcout jsr MLI dc.b QUIT dc.w @parmTable @parmTable dc.b 4 dc.b 0 dc.w 0 dc.b 0 dc.w 0 runit jsr rtcout jmp $2000 saveit jsr rtcout _var filetype jsr getint bcc @ok7 jsr crEOFMessage _write 'filetype.' jmp abort @ok7 _var auxtype jsr getint bcc @ok8 jsr crEOFMessage _write 'auxtype.' jmp abort @ok8 _writecr ;Go ahead and save it. _var filestr jsr getstr bcc @ok9 jsr crEOFMessage _write 'application filename.' jmp abort @ok9 _write 13,'Saving application as ' _prstr lda varspace+applen sta @len lda varspace+applen+1 sta @len+1 jsr saveFile dc.w $2000 @len dc.w $FFFF bcc @a _write 13,13,'Could not save ' _prstr filestr _write '.' jmp abort @a jsr getFileInfo ;Update filetype and auxtype. bcc @b _write 13,13,'Could not get file info for ' _prstr filestr _write '.' jmp abort @b jsr getToSet ;Move getInfo data to setInfo block. lda varspace+filetype ;Set filetype and auxtype. sta setFileInfoBlock+setInfo_filetype lda varspace+auxtype sta setFileInfoBlock+setInfo_auxtype jsr setFileInfo bcc @c _write 13,13,'Could not set file info for ' _prstr filestr _write '.' jmp abort @c jmp $2000 ;Launch application. noLoad _write 13,13,'Could not load ' _prstr filestr _write '.' abort _write 13,'Please fix and press any key to rebuild ',\ '(or Q to quit). ' jsr rdkey and #$5F cmp #'Q' bne @a jmp quit @a jmp restart getstr txa pha jsr fillbffrstr pla tax bcs @rts @ok _strcpy ,bffrstr lda #0 sta strlens+bffrstr clc @rts rts getint stx @xreg jsr fillbffrstr ;Make sure we have something to chew. bcs @exit ;If we don't, return an error. _strval bffrstr ;Get the value of the string and ldx @xreg ;put it in the variable. _set _var bffrstr ldy #0 sty decimalint @a tya ;First skip over -'s. _strchr iny cmp #'-' beq @a cmp #'$' beq @b dec decimalint ;It was a decimal integer. @b ldy strvalcount @c tya cmp strlens,x bcs @d ;Ran out of string. _strchr iny cmp #',' bne @c tya @d _midstrcpy ,bffrstr clc ;All went well. @exit ldx @xreg ;Restore x-reg. rts ;All done @xreg dc.b 0 decimalint dc.b 0 fillbffrstr lda strlens+bffrstr ;See if there is any string left. beq @a ;There is not, so get another. clc rts ;There is, so munch away. @a _readstr bffrstr ;Read in the next. jsr stripComment ;Chew off comments -- (who needs them?) lda strlens+bffrstr ;How did we do? beq @a ;Empty line -- try again. lda bffrstrloc ;Check for eof marker. cmp #255 rts ;Return carry set if eof hit. stripComment txa pha asl a tax lda strlocs,x ;Point to the string. sta ptr lda strlocs+1,x sta ptr+1 pla tax ldy #0 @a tya cmp strlens,x beq @b ;Hit end-of-string. lda (ptr),y iny cmp #';' bne @a ;Not at comment yet. dey @b dey ;Remove all trailing white-space. bpl @c ;Still some characters left. lda #0 sta strlens,x ;Ran out of string. rts @c lda (ptr),y ;See if it white-space. cmp #9 beq @b ;If it is, keep backing up. cmp #' ' beq @b iny ;We ran into something solid. tya sta strlens,x @noComment rts crEOFMessage _writecr EOFMessage _write 'Build script EOF hit while reading ' rts ********************************************* createFile jsr MLI dc.b CREATE dc.w createBlock rts createBlock dc.b 7 dc.w fileName dc.b $C3 dc.b $06 dc.w $2000 dc.b $01 dc.w $00 dc.w $00 setFileInfo jsr MLI dc.b SETFILEINFO dc.w setFileInfoBlock rts setFileInfoBlock dc.b 7 dc.w fileName dc.b 0 dc.b 0 dc.w 0 ds.b 3 dc.w 0 dc.w 0 getFileInfo jsr MLI dc.b GETFILEINFO dc.w getFileInfoBlock rts getFileInfoBlock dc.b 10 dc.w fileName dc.b 0 dc.b 0 dc.w 0 ds.b 1 dc.w 1 dc.w 0 dc.w 0 dc.w 0 dc.w 0 getToSet ldy #13-1 @a lda getFileInfoBlock+getInfo_pathname,y sta setFileInfoBlock+getInfo_pathname,y dey bpl @a rts openFile jsr MLI dc.b OPEN dc.w openBlock ldx openBlock+open_refnum stx readBlock+read_refnum stx writeBlock+write_refnum stx setEOFBlock+setEOF_refnum stx closeBlock+close_refnum rts openBlock dc.b 3 dc.w fileName dc.w $BF00-1024 dc.b 1 readFile jsr MLI dc.b READ dc.w readBlock rts readBlock dc.b 4 dc.b 1 dc.w $2000 dc.w $2000 dc.w 0 writeFile jsr MLI dc.b WRITE dc.w writeBlock rts writeBlock dc.b 4 dc.b 1 dc.w $2000 dc.w $2000 dc.w 0 setEOF jsr MLI dc.b SETEOF dc.w setEOFBlock rts setEOFBlock dc.b 2 dc.b 1 ds.b 3 closeFile jsr MLI dc.b CLOSE dc.w closeBlock rts closeBlock dc.b 1 dc.b 1 loadFile pla ;Set ptr to point to params. sta ptr pla sta ptr+1 jsr prepFile ;Get all data ready. lda ptr+1 ;Restore return address. pha lda ptr pha jsr openFile ;Try opening the file. bcs @rts ;Bad news... jsr readFile ;Try reading the file. bcc @a ;Good news. php ;Read failed -- try closing the pha ;file and restoring the error jsr closeFile ;to the read error status. pla plp rts @a jsr closeFile ;Return result of close. @rts rts saveFile pla ;Set ptr to point to params. sta ptr pla sta ptr+1 jsr prepFile ;Get all data ready. lda ptr+1 ;Restore return address. pha lda ptr pha jsr createFile ;Try creating file. bcc @a ;There was no such file. cmp #$47 ;Make sure error is duplicate file error. sec bne @rts @a jsr openFile ;Try opening the file. bcs @rts ;Bad news... jsr writeFile ;Try writing the file. bcc @b ;Good news. php ;Write failed -- try closing the pha ;file and restoring the error jsr closeFile ;to the write error status. pla plp rts @b lda writeBlock+write_reqcount sta setEOFBlock+setEOF_EOF lda writeBlock+write_reqcount+1 sta setEOFBlock+setEOF_EOF+1 lda #0 sta setEOFBlock+setEOF_EOF+2 jsr setEOF bcc @c php pha jsr closeFile pla plp rts @c jsr closeFile ;Return result of close. @rts rts prepFile lda strlens+filestr sta fileName ;Length of string. ldy #1 lda (ptr),y sta readBlock+read_databuffer sta writeBlock+write_databuffer iny lda (ptr),y sta readBlock+read_databuffer+1 sta writeBlock+write_databuffer+1 iny lda (ptr),y sta readBlock+read_reqcount sta writeBlock+write_reqcount iny lda (ptr),y sta readBlock+read_reqcount+1 sta writeBlock+write_reqcount+1 tya clc adc ptr sta ptr bcc @d inc ptr+1 @d rts endp END